home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / HTML / Parser.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  7.4 KB  |  303 lines
  1. package HTML::Parser;
  2.  
  3.  
  4. =head1 NAME
  5.  
  6. HTML::Parser - SGML parser class
  7.  
  8. =head1 SYNOPSIS
  9.  
  10.  require HTML::Parser;
  11.  $p = HTML::Parser->new;  # should really a be subclass
  12.  $p->parse($chunk1);
  13.  $p->parse($chunk2);
  14.  $p->eof;                 # signal end of document
  15.  
  16.  $p->parse_file("foo.html");
  17.  open(F, "foo.html") || die;
  18.  $p->parse_file(\*F);
  19.  
  20. =head1 DESCRIPTION
  21.  
  22. The C<HTML::Parser> will tokenize a HTML document when the $p->parse()
  23. method is called.  The document to parse can be supplied in arbitrary
  24. chunks.  Call $p->eof() the end of the document to flush any remaining
  25. text.  The return value from parse() is a reference to the parser
  26. object.
  27.  
  28. The $p->parse_file() method can be called to parse text from a file.
  29. The argument can be a filename or an already opened file handle. The
  30. return value from parse_file() is a reference to the parser object.
  31.  
  32. In order to make the parser do anything interesting, you must make a
  33. subclass where you override one or more of the following methods as
  34. appropriate:
  35.  
  36. =over 4
  37.  
  38. =item $self->declaration($decl)
  39.  
  40. This method is called when a I<markup declaration> has been
  41. recognized.  For typical HTML documents, the only declaration you are
  42. likely to find is <!DOCTYPE ...>.  The initial "<!" and ending ">" is
  43. not part of the string passed as argument.  Comments are removed and
  44. entities have B<not> been expanded yet.
  45.  
  46. =item $self->start($tag, $attr, $attrseq, $origtext)
  47.  
  48. This method is called when a complete start tag has been recognized.
  49. The first argument is the tag name (in lower case) and the second
  50. argument is a reference to a hash that contain all attributes found
  51. within the start tag.  The attribute keys are converted to lower case.
  52. Entities found in the attribute values are already expanded.  The
  53. third argument is a reference to an array with the lower case
  54. attribute keys in the original order.  The fourth argument is the
  55. original HTML text.
  56.  
  57.  
  58. =item $self->end($tag)
  59.  
  60. This method is called when an end tag has been recognized.  The
  61. argument is the lower case tag name.
  62.  
  63. =item $self->text($text)
  64.  
  65. This method is called when plain text in the document is recognized.
  66. The text is passed on unmodified and might contain multiple lines.
  67. Note that for efficiency reasons entities in the text are B<not>
  68. expanded.  You should call HTML::Entities::decode($text) before you
  69. process the text any further.
  70.  
  71. =item $self->comment($comment)
  72.  
  73. This method is called as comments are recognized.  The leading and
  74. trailing "--" sequences have been stripped off the comment text.
  75.  
  76. =back
  77.  
  78. The default implementation of these methods does nothing, I<i.e.,> the
  79. tokens are just ignored.
  80.  
  81. There is really nothing in the basic parser that is HTML specific, so
  82. it is likely that the parser can parse many kinds of SGML documents,
  83. but SGML has many obscure features (not implemented by this module)
  84. that prevent us from renaming this module as C<SGML::Parse>.
  85.  
  86. =head1 BUGS
  87.  
  88. You can instruct the parser to parse comments the way Netscape does it
  89. by calling the netscape_buggy_comment() method with a TRUE argument.
  90. This means that comments will always be terminated by the first
  91. occurence of "-->".
  92.  
  93. =head1 SEE ALSO
  94.  
  95. L<HTML::TreeBuilder>, L<HTML::HeadParser>, L<HTML::Entities>
  96.  
  97. =head1 COPYRIGHT
  98.  
  99. Copyright 1996 Gisle Aas. All rights reserved.
  100.  
  101. This library is free software; you can redistribute it and/or
  102. modify it under the same terms as Perl itself.
  103.  
  104. =head1 AUTHOR
  105.  
  106. Gisle Aas <aas@sn.no>
  107.  
  108. =cut
  109.  
  110.  
  111. use strict;
  112.  
  113. use HTML::Entities ();
  114. use vars qw($VERSION);
  115. $VERSION = sprintf("%d.%02d", q$Revision: 2.6 $ =~ /(\d+)\.(\d+)/);
  116.  
  117.  
  118. sub new
  119. {
  120.     my $class = shift;
  121.     my $self = bless { '_buf'              => '',
  122.                '_netscape_comment' => 0,
  123.              }, $class;
  124.     $self;
  125. }
  126.  
  127.  
  128.  
  129. sub eof
  130. {
  131.     shift->parse(undef);
  132. }
  133.  
  134.  
  135. sub parse
  136. {
  137.     my $self = shift;
  138.     my $buf = \ $self->{'_buf'};
  139.     unless (defined $_[0]) {
  140.     $self->text($$buf) if length $$buf;
  141.     $$buf = '';
  142.     return $self;
  143.     }
  144.     $$buf .= $_[0];
  145.  
  146.     while (1) {  # the loop will end by returning when text is parsed
  147.     if ($$buf =~ s|^([^<]+)||) {
  148.         unless (length $$buf) {
  149.         my $text = $1;
  150.         if ($text =~ s|(\s+)$||) {
  151.             $$buf = $1;
  152.         } elsif ($text =~ s/(&(?:(?:\#\d*)?|\w*))$//) {
  153.             $$buf = $1;
  154.         };
  155.         $self->text($text);
  156.         return $self;
  157.         } else {
  158.         $self->text($1);
  159.         }
  160.     } elsif ($self->{'_netscape_comment'} && $$buf =~ m|^(<!--)|) {
  161.         if ($$buf =~ s|^<!--(.*?)-->||s) {
  162.         $self->comment($1);
  163.         } else {
  164.         return $self;  # must wait until we see the end of it
  165.         }
  166.     } elsif ($$buf =~ s|^(<!)||) {
  167.         my $eaten = $1;
  168.         my $text = '';
  169.         my @com = ();  # keeps comments until we have seen the end
  170.         while ($$buf =~ s|^(([^>]*?)--)||) {
  171.         $eaten .= $1;
  172.         $text .= $2;
  173.         if ($$buf =~ s|^((.*?)--)||s) {
  174.             $eaten .= $1;
  175.             push(@com, $2);
  176.         } else {
  177.             $$buf = $eaten . $$buf;
  178.             return $self;
  179.         }
  180.         }
  181.         if ($$buf =~ s|^([^>]*)>||) {
  182.         $text .= $1;
  183.         $self->declaration($text) if $text =~ /\S/;
  184.         for (@com) { $self->comment($_); }
  185.         } else {
  186.         $$buf = $eaten . $$buf;  # must start with it all next time
  187.         return $self;
  188.         }
  189.     } elsif ($$buf =~ s|^</||) {
  190.         if ($$buf =~ s|^([a-zA-Z][a-zA-Z0-9\.\-]*)\s*>||) {
  191.         $self->end(lc($1));
  192.         } elsif ($$buf =~ m|^[a-zA-Z]*[a-zA-Z0-9\.\-]*\s*$|) {
  193.         $$buf = "</" . $$buf;  # need more data to be sure
  194.         return $self;
  195.         } else {
  196.         $self->text("</");
  197.         }
  198.     } elsif ($$buf =~ s|^<||) {
  199.         my $eaten = '<';
  200.  
  201.         if ($$buf =~ s|^(([a-zA-Z][a-zA-Z0-9\.\-]*)\s*)||) {
  202.         $eaten .= $1;
  203.         my $tag = lc $2;
  204.         my %attr;
  205.         my @attrseq;
  206.  
  207.         while ($$buf =~ s|^(([a-zA-Z][a-zA-Z0-9\.\-_]*)\s*)||) {
  208.             $eaten .= $1;
  209.             my $attr = lc $2;
  210.             my $val;
  211.             if ($$buf =~ s|(^=\s*([^\"\'>\s][^>\s]*)\s*)||) {
  212.             $eaten .= $1;
  213.             $val = $2;
  214.             HTML::Entities::decode($val);
  215.             } elsif ($$buf =~ s|(^=\s*([\"\'])(.*?)\2\s*)||s) {
  216.             $eaten .= $1;
  217.             $val = $3;
  218.             HTML::Entities::decode($val);
  219.             } elsif ($$buf =~ m|^(=\s*)$| or
  220.                  $$buf =~ m|^(=\s*[\"\'].*)|s) {
  221.             $$buf = "$eaten$1";
  222.             return $self;
  223.             } else {
  224.             $val = $attr;
  225.             }
  226.             $attr{$attr} = $val;
  227.             push(@attrseq, $attr);
  228.         }
  229.  
  230.         if ($$buf =~ s|^>||) {
  231.             $self->start($tag, \%attr, \@attrseq, "$eaten>");
  232.         } elsif (length $$buf) {
  233.             $self->text($eaten);
  234.         } else {
  235.             $$buf = $eaten;  # need more data to know
  236.             return $self;
  237.         }
  238.  
  239.         } elsif (length $$buf) {
  240.         $self->text($eaten);
  241.         } else {
  242.         $$buf = $eaten . $$buf;  # need more data to parse
  243.         return $self;
  244.         }
  245.  
  246.     } elsif (length $$buf) {
  247.         die; # This should never happen
  248.     } else {
  249.         return $self;
  250.     }
  251.     }
  252.     $self;
  253. }
  254.  
  255. sub netscape_buggy_comment
  256. {
  257.     my $self = shift;
  258.     my $old = $self->{'_netscape_comment'};
  259.     $self->{'_netscape_comment'} = shift if @_;
  260.     return $old;
  261. }
  262.  
  263. sub parse_file
  264. {
  265.     my($self, $file) = @_;
  266.     no strict 'refs';  # so that a symbol ref as $file works
  267.     local(*F);
  268.     unless (ref($file) || $file =~ /^\*[\w:]+$/) {
  269.     open(F, $file) || die "Can't open $file: $!";
  270.     $file = \*F;
  271.     }
  272.     my $chunk = '';
  273.     while(read($file, $chunk, 2048)) {
  274.     $self->parse($chunk);
  275.     }
  276.     close($file);
  277.     $self->eof;
  278. }
  279.  
  280. sub text
  281. {
  282. }
  283.  
  284. sub declaration
  285. {
  286. }
  287.  
  288. sub comment
  289. {
  290. }
  291.  
  292. sub start
  293. {
  294.     my($self, $tag, $attr, $attrseq, $origtext) = @_;
  295. }
  296.  
  297. sub end
  298. {
  299.     my($self, $tag) = @_;
  300. }
  301.  
  302. 1;
  303.